home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / GD13HI.for < prev    next >
Text File  |  1991-04-13  |  9KB  |  334 lines
  1.         SUBROUTINE GD13HI(IFXN,XA,YA)
  2. C
  3. C***   AMIGA 13" MONITOR DRIVER FOR DIGLIB, Craig Wuest, 1986
  4. C***   HI-RES MODE (640 X 400, 16 COLORS)
  5.  
  6. C      Modified and enhanced by Jim Locker, 1988, 1989, 1990
  7. C-----------------------------------------------------------------------
  8.     IMPLICIT NONE
  9. C
  10. C
  11.     INCLUDE AMIGA$KOM:EXEC.INC
  12.     INCLUDE AMIGA$KOM:GRAPH.INC
  13.     INCLUDE AMIGA$KOM:INTUIT.INC
  14.     INCLUDE DIGLIB$KOM:WINDOW.INC
  15.     INCLUDE DIGLIB$KOM:GCDCHR.PRM
  16. C
  17.  
  18.     INTEGER*4 IXPOSN,IYPOSN
  19.     INTEGER   IX,IY,NPTS,I
  20.     INTEGER*4 ARRAY(16)
  21.     REAL*4 XA(8),YA(3),DCHAR(8)
  22. C
  23. C
  24. C       DECLARE VARS NEED FOR DRIVER OPERATION
  25. C
  26.     INTEGER amiga,loc        !DECLARE AMIGA FUNCTIONS
  27. C
  28.     INTEGER*4 RED(0:15),GREEN(0:15),BLUE(0:15)
  29.         REAL TEMP2,TEMP3
  30. C
  31.         INTEGER*2 NorDisRow,NorDisCols,NorXRPM,NorYRPM
  32.         INTEGER*4 wdwht,wdwwth
  33.     INTEGER*4 i,message,class
  34.  
  35. C
  36. C DCHAR(1) IS AN ID NUMBER (A BIG DON'T CARE)
  37. C      (2) IS LENGTH IN CM OF X AXIS
  38. C      (3) IS LENGTH IN CM OF Y AXIS
  39. C      (4) IS PIXELS PER CM IN X DIRECTION
  40. C      (5) IS PIXELS PER CM IN Y DIRECTION
  41. C      (6) IS NUMBER OF DISPLAY COLORS
  42. C      (7) IS DEVICE CHARACTERISTIC FLAG (ALWAYS = 69 FOR CRT)
  43. C      (8) IS IMPORTANT TO PLOTTERS BUT NOT TO TUBES. (SHOULD BE 1)
  44. C
  45.         DATA DCHAR /1301.0,25.2,17.5,23.5,23.5,15.0,69.0,1.0/
  46.         DATA NorDisRow/216/,NorDisCols/218/ !GfxBase offsets to VDT info
  47.         DATA NorXRPM/220/,NorYRPM/222/ ! offsets to dpm in low res mode
  48. C    w_title = "MatLab Plots "//CHAR(0)
  49. C
  50. C
  51. C*****************
  52. C
  53. C       FIRST VERIFY WE GOT A GRAPHICS FUNCTION WE CAN HANDLE
  54. C
  55.         IF (IFXN .LE. 0 .OR. IFXN .GT. 13) RETURN
  56.         IF (IFXN .EQ. 11) RETURN
  57. C
  58. C       NOW DISPATCH TO THE PROPER CODE TO HANDLE THAT FUNCTION
  59. C
  60.         GO TO (100,200,300,400,500,600,700,800,900,1000,1100,1200
  61.      1  ,1300) IFXN
  62. C
  63. C       *********************
  64. C       INITIALIZE THE DEVICE
  65. C       *********************
  66. C
  67. 100     CONTINUE
  68. C
  69. C
  70. C       FIRST, INITIALIZE THE SCREEN AND WINDOW TO USE
  71. C
  72.     GFXBASE = amiga(OpenLibrary,'graphics.library'//CHAR(0)
  73.      1     ,0) !open graphics library
  74.     IF (GFXBASE=0) STOP "'Cannot open graphics library?!'"
  75.         scrwth = word(GFXBASE+NorDisCols) !ask the system how many columns
  76.         scrht = word(GFXBASE+NorDisRow)   !now ask about rows
  77.         scrht = scrht + scrht       !set height for interlace
  78. C
  79.         Xrosiz = word(GFXBASE+NorXRPM) ! determine dots per meter x in lo res
  80.         Yrosiz = word(GFXBASE+NorYRPM) ! and dots per meter y in lo res
  81.         Xrosiz = Xrosiz + Xrosiz ! double them for hi res, interlace
  82.         Yrosiz = Yrosiz + Yrosiz
  83.  
  84. C
  85. C    
  86. C    SET UP THE NewScreen data block and allocate the screen
  87.  
  88.       ns_LeftEdge   = 0
  89.       ns_TopEdge    = 0
  90.       ns_Width      = scrwth
  91.       ns_Height     = scrht
  92.       ns_Depth      = 4
  93.       ns_DetailPen  = 1
  94.       ns_BlockPen   = 0
  95.       ns_ViewModes  = HIRES .or. LACE
  96.       ns_Type       = CUSTOMSCREEN
  97.       ns_Font       = loc(TextAttr)
  98.       ns_DefTitle   = 0
  99.       ns_Gadgets    = 0
  100.       ns_CustBitMap = 0
  101.  
  102.       Screen = amiga(OpenScreen,NewScreen)
  103.       if (Screen=0) stop "'OpenScreen' failed"
  104. C
  105. C     Send screen to back so user can see prompts
  106. C
  107.       WRITE(9,199)
  108. 199   FORMAT('Click to back screen to see plot')
  109.       CALL amiga(ScreenToBack,Screen)
  110. C
  111.         RETURN
  112. C
  113. C       **************************
  114. C       GET FRESH PLOTTING SURFACE
  115. C       **************************
  116. C
  117. 200     CONTINUE
  118.  
  119.       wdwwth=scrwth
  120.       wdwht=scrht
  121. * - set up the NewWindow data block
  122.  
  123.       nw_LeftEdge   = 0
  124.       nw_TopEdge    = 0
  125.       nw_Width      = wdwwth
  126.       nw_Height     = wdwht
  127.       nw_DetailPen  = 1
  128.       nw_BlockPen   = 0
  129.       nw_Title      = loc(w_title)
  130.       nw_Flags      = WINDOWCLOSE .or. SMART_REFRESH .or. ACTIVATE .or.
  131.      +                WINDOWSIZING .or. WINDOWDRAG .or. WINDOWDEPTH
  132.       nw_IDCMPFlags = CLOSEWINDOW
  133.       nw_Type       = CUSTOMSCREEN
  134.       nw_FirstGdgt  = 0
  135.       nw_CheckMark  = 0
  136.       nw_Screen     = Screen
  137.       nw_BitMap     = 0
  138.       nw_MinWidth   = 100
  139.       nw_MinHeight  = 25
  140.       nw_MaxWidth   = wdwwth
  141.       nw_MaxHeight  = wdwht
  142.  
  143.       Window = amiga(OpenWindow,NewWindow)
  144.       if (Window=0) stop "'OpenWindow' failed"
  145.  
  146.     WIDTH = wdwwth
  147.     HEIGHT = wdwht
  148. C
  149. C    Set up color map for DIGLIB default colors 0 through 7
  150. C    Color 0 = black (background)
  151. C    Color 1 = white (foreground)
  152. C    Color 2 = red
  153. C    Color 3 = green
  154. C    Color 4 = blue
  155. C    Color 5 = yellow
  156. C    Color 6 = magenta
  157. C    Color 7 = cyan
  158. C
  159.     RED(0)= 0;GREEN(0)= 0;BLUE(0)= 0
  160.     RED(1)=15;GREEN(1)=15;BLUE(1)=15
  161.     RED(2)=15;GREEN(2)= 0;BLUE(2)= 0
  162.     RED(3)= 0;GREEN(3)=15;BLUE(3)= 0
  163.     RED(4)= 0;GREEN(4)= 0;BLUE(4)=15
  164.     RED(5)=15;GREEN(5)=15;BLUE(5)= 0
  165.     RED(6)=15;GREEN(6)= 0;BLUE(6)=15
  166.     RED(7)= 0;GREEN(7)=15;BLUE(7)=15
  167. C
  168.     viewport = amiga(ViewPortAddress,Window)
  169.     DO(i = 0,7)
  170.     CALL amiga(SetRGB4,viewport,i,RED(i),GREEN(i),BLUE(i))
  171.     repeat
  172.     ICOLOR = 1
  173.     CALL amiga(SetAPen,long(Window+wd_RPort),ICOLOR)
  174.         RETURN
  175. C
  176. C
  177. C       ****
  178. C       MOVE
  179. C       ****
  180. C
  181. 300     CONTINUE
  182. C       CONVERT CM. TO GRAPHICS UNITS ROUNDED
  183.         IXPOSN = XRES*XA(1)+0.5
  184.         IYPOSN = FLOAT(HEIGHT)-YRES*YA(1)+0.5     !invert y position
  185. C        call Mov(GFXBASE,long(Window+wd_RPort),IXPOSN,IYPOSN)
  186.     call amiga(Move,long(Window+wd_RPort),IXPOSN,IYPOSN)
  187.         RETURN
  188. C
  189. C       ****
  190. C       DRAW
  191. C       ****
  192. C
  193. 400     CONTINUE
  194.         IXPOSN = XRES*XA(1)+0.5
  195.         IYPOSN = FLOAT(HEIGHT)-YRES*YA(1)+0.5
  196. C
  197. C       DRAW A LINE
  198. C
  199. C        call Draw(GFXBASE,long(Window+wd_RPort),IXPOSN,IYPOSN)
  200.     call amiga(Draw,long(Window+wd_RPort),IXPOSN,IYPOSN)
  201. C
  202.         RETURN
  203. C
  204. C       *****************************
  205. C       FLUSH GRAPHICS COMMAND BUFFER
  206. C       *****************************
  207. C
  208. 500     CONTINUE
  209.     CALL GSWAIT    !Wait for mouse click on CloseWindow Gadget
  210.         call amiga(CloseWindow,Window)
  211.         RETURN
  212. C
  213. C       ******************
  214. C       RELEASE THE DEVICE
  215. C       ******************
  216. C
  217. 600     CONTINUE
  218. C
  219. C       DE-ASSIGN THE CHANNEL
  220. C
  221.         call amiga(CloseScreen,Screen)
  222.         call amiga(CloseLibrary,GFXBASE)
  223. C
  224.         RETURN
  225. C
  226. C       *****************************
  227. C       RETURN DEVICE CHARACTERISTICS
  228. C       *****************************
  229. C
  230. 700     CONTINUE
  231. C
  232. C   now figure the x and y screen size for this monitor (centimeter).
  233. C
  234.         DCHAR(2)=100 * FLOAT(scrwth)/FLOAT(Xrosiz)
  235.         DCHAR(3)=100 * FLOAT(scrht)/FLOAT(Yrosiz)       
  236. C
  237. C figure the x and y resolutions
  238. C
  239.         DCHAR(4)= FLOAT(scrwth)/DCHAR(2)
  240.         DCHAR(5)= FLOAT(scrht)/DCHAR(3)
  241. C
  242. C now average the x and y resolutions, then adjust the x and y axes
  243. C so the display will look right (45 degree angles look 45 degrees, etc.)
  244. C
  245.         DCHAR(4)=(DCHAR(4)+DCHAR(5))/2
  246.         DCHAR(5)=DCHAR(4)
  247.         TEMP2=FLOAT(scrwth)*DCHAR(4)
  248.         TEMP3=FLOAT(scrht)*DCHAR(5)
  249.         DCHAR(2)=AMIN1(TEMP2,DCHAR(2))
  250.         DCHAR(3)=AMIN1(TEMP3,DCHAR(3))
  251. C
  252.         DO 720 I=1,8
  253.         XA(I) = DCHAR(I)
  254. 720     CONTINUE
  255.         RETURN
  256. C
  257. C       ****************************
  258. C       SELECT CURRENT DRAWING COLOR
  259. C       ****************************
  260. C
  261. 800     CONTINUE
  262.     ICOLOR = XA(1)
  263.         call amiga(SetAPen,long(Window+wd_RPort),ICOLOR)
  264.         RETURN
  265. C
  266. C       ***********************************
  267. C       PERFORM GRAPHICS INPUT WITH BUTTONS
  268. C       ***********************************
  269. C
  270. 900     CONTINUE
  271. C
  272. C       Wait for mouse click in CloseWindow gadget
  273. C
  274.     call amiga(Wait,shift(1,byte(long(Window+wd_UserPort)
  275.      1                  +MP_SIGBIT)))
  276.         RETURN
  277. C
  278. C       **********************
  279. C       DEFINE COLOR USING RGB
  280. C       **********************
  281. C
  282. 1000    CONTINUE
  283.     i=XA(1)
  284.     RED(i)=(YA(1)*15./100.)
  285.     GREEN(i)=(YA(2)*15./100.)
  286.     BLUE(i)=(YA(3)*15./100.)
  287.     CALL amiga(SetRGB4,viewport,i,RED(i),GREEN(i),BLUE(i))
  288. C
  289.         RETURN
  290. C
  291. 1100    CONTINUE
  292.     RETURN
  293. C
  294. C    *******************
  295. C    DRAW FILLED POLYGON    !DEFEATED FOR THE TIME BEING USE SOFTWARE!
  296. C    *******************
  297. C
  298. 1200    CONTINUE
  299.     NPTS = IFXN - 1024
  300.     DO (I = 1,NPTS)
  301.     IX = XRES*XA(NPTS) + 0.5
  302.     IY = YRES*YA(NPTS) + 0.5
  303.     ARRAY(2*I-1) = IX
  304.     ARRAY(2*I) = IY
  305.     REPEAT
  306.  
  307.     CALL amiga(PolyDraw,long(Window+wd_RPort),NPTS,ARRAY)
  308. C
  309. C    FIND A POINT INSIDE THE POLYGON TO START FILL FROM
  310. C
  311. CC    DIFFX = (ARRAY(1)-ARRAY(3))/2
  312. CC    DIFFY = (ARRAY(2)-ARRAY(4))/2
  313. CC    DIFFX = (DIFFX-ARRAY(5))/2
  314. CC    DIFFY = (DIFFY-ARRAY(6))/2
  315. C
  316. CC    CALL amiga(Flood,long(Window+wd_Rport),1,DIFFX,DIFFY)
  317. C
  318. C     ***********************************************
  319. C     * CHECK FOR CLICK ON CLOSE BUTTON ON THE FLY. *
  320. C     ***********************************************
  321. 1300    CONTINUE
  322.         XA(1)=0
  323.         message = amiga(GetMsg,long(Window+wd_UserPort))
  324.          if(message<>0) then
  325.           class = long(message+im_Class)
  326.           call amiga(ReplyMsg,message)
  327.           if (class .EQ. CLOSEWINDOW) then
  328.            call amiga(CloseWindow,Window)
  329.            XA(1)=1
  330.           endif
  331.          endif
  332.         RETURN
  333.         END
  334.